home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor2 / plt3d.src < prev    next >
Text File  |  1992-08-18  |  3KB  |  180 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ PLT3D by Dave Jansen
  3. DIR
  4.   SFACE
  5.     \<< SPAR OBJ\->
  6. DROP 0 { } \-> xa xb
  7. xi ya yb yi theta
  8. phi p z h v d flg
  9.       \<< RCLF 'flg'
  10. STO -20 -21 -22 SF
  11. CF CF RAD ya yb
  12.         FOR J J 'Y'
  13. STO xa xb
  14.           FOR I I
  15. 'X' STO DEPTH 'd'
  16. STO
  17.             IFERR
  18. EQ \->NUM
  19.             THEN
  20. DEPTH d - DROPN 0
  21.             END
  22.             IF DUP
  23. TYPE 1 ==
  24.             THEN
  25. DROP 0
  26.             END yi
  27.           STEP xi
  28.         STEP yb ya
  29. - ABS 1 + xb xa -
  30. ABS 1 + 2 \->LIST
  31. \->ARRY 'TOPO' STO {
  32. X Y } PURGE DEG -20
  33. -21 -22 CF SF SF
  34. 'flg' RCL STOF
  35. TRACE
  36.       \>>
  37.     \>>
  38.   TRACE
  39.     \<< SPAR OBJ\->
  40. DROP { } \-> xa xb xi
  41. ya yb yi theta phi
  42. p z h v flg
  43.       \<< 0 0 0 0 0 \->
  44. cphi sphi ctheta
  45. stheta prv
  46.         \<< RCLF
  47. 'flg' STO 64 STWS
  48. PICT PURGE { # 0d
  49. # 0d } PVIEW AXIS
  50. RAD theta \pi * 180 /
  51. \->NUM DUP SIN
  52. 'stheta' STO COS
  53. 'ctheta' STO phi \pi
  54. * 180 / \->NUM DUP
  55. SIN 'sphi' STO COS
  56. 'cphi' STO ya yb
  57.           FOR j j
  58. cphi * xa ctheta *
  59. - h * 65 + 0 RND
  60. # 1d * 63 j NEG
  61. sphi * xa stheta *
  62. - v * 31 + 0 RND
  63. TOPO 1 j ya - yi *
  64. 1 + 2 \->LIST GET
  65.             IF p 0
  66. \=/
  67.             THEN
  68.               IF
  69. DUP DUP z < p 0 >
  70. AND SWAP z > p 0 <
  71. AND OR
  72.               THEN
  73. DROP z
  74.               END
  75.             END + -
  76. # 1d * 2 \->LIST
  77. 'prv' STO 1 xa + xb
  78.             FOR i
  79. prv j cphi * i
  80. ctheta * - h * 65 +
  81. 0 RND # 1d * 63 j
  82. NEG sphi * i stheta
  83. * - v * 31 + 0 RND
  84. TOPO i xa - xi * 1
  85. + j ya - yi * 1 + 2
  86. \->LIST GET
  87.               IF p
  88. 0 \=/
  89.               THEN
  90. IF DUP DUP z < p 0
  91. > AND SWAP z > p 0
  92. < AND OR
  93. THEN DROP z
  94. END
  95.               END +
  96. - # 1d * 2 \->LIST
  97. DUP 'prv' STO LINE
  98. xi
  99.             STEP yi
  100.           STEP xa
  101. xb
  102.           FOR i ya
  103. cphi * i ctheta * -
  104. h * 65 + 0 RND # 1d
  105. * 63 ya NEG sphi *
  106. i stheta * - v * 31
  107. + 0 RND TOPO i xa -
  108. xi * 1 + 1 2 \->LIST
  109. GET
  110.             IF p 0
  111. \=/
  112.             THEN
  113.               IF
  114. DUP DUP z < p 0 >
  115. AND SWAP z > p 0 <
  116. AND OR
  117.               THEN
  118. DROP z
  119.               END
  120.             END + -
  121. # 1d * 2 \->LIST
  122. 'prv' STO 1 ya + yb
  123.             FOR j
  124. prv j cphi * i
  125. ctheta * - h * 65 +
  126. 0 RND # 1d * 63 j
  127. NEG sphi * i stheta
  128. * - v * 31 + 0 RND
  129. TOPO i xa - xi * 1
  130. + j ya - yi * 1 + 2
  131. \->LIST GET
  132.               IF p
  133. 0 \=/
  134.               THEN
  135. IF DUP DUP z < p 0
  136. > AND SWAP z > p 0
  137. < AND OR
  138. THEN DROP z
  139. END
  140.               END +
  141. - # 1d * 2 \->LIST
  142. DUP 'prv' STO LINE
  143. yi
  144.             STEP xi
  145.           STEP DEG
  146. PICT RCL 'GRPH' STO
  147.           DO
  148.           UNTIL KEY
  149.           END DROP
  150.         \>> 'flg' RCL
  151. STOF
  152.       \>>
  153.     \>>
  154.   AXIS
  155.     \<< SPAR OBJ\->
  156. DROP { } \-> xa xb xi
  157. ya yb yi theta phi
  158. p z h v flg
  159.       \<< RCLF 'flg'
  160. STO DEG { # 65d
  161. # 32d } DUP DUP {
  162. # 65d # 0d } LINE
  163. 10 h * theta COS *
  164. NEG 65 + 0 RND # 1d
  165. * 63 10 v * theta
  166. SIN * NEG 31 + - 0
  167. RND # 1d * 2 \->LIST
  168. LINE 10 h * phi COS
  169. * 65 + 0 RND # 1d *
  170. 63 10 v * phi SIN *
  171. NEG 31 + - 0 RND
  172. # 1d * 2 \->LIST LINE
  173. 'flg' RCL STOF
  174.       \>>
  175.     \>>
  176.   SPAR { -5 5 1 -5
  177. 5 1 30 45 0 0 5 3 }
  178.   EQ 'Y^2-X^2'
  179. END
  180.